home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / icon / packages.lha / packages / atari / ats.arc / TESTS.ARC / CONCORD.ICN < prev    next >
Text File  |  1990-03-28  |  1KB  |  32 lines
  1. procedure main()
  2.    local letters, line, wordlist, word, words, maxword, lineno, i
  3.    local j, lines, numbers
  4.    letters := &lcase ++ &ucase ++ '\''
  5.    words := table("")
  6.    maxword := lineno := 0
  7.    while line := read() do {
  8.       lineno +:= 1
  9.       write(right(lineno,6),"  ",line)
  10.       line := map(line)                # fold to lowercase
  11.       i := 1
  12.       while j := upto(letters,line,i) do {
  13.          i := many(letters,line,j)
  14.          word := line[j:i]
  15.          if *word < 3 then next            # skip short words
  16.          maxword <:= *word            # keep track of longest word
  17.                         # if it's a new word, start set
  18.          if *words[word] = 0 then words[word] := set([lineno])
  19.          else insert(words[word],lineno)    # else add the line number
  20.          }
  21.       }
  22.    write()
  23.    wordlist := sort(words)            # sort by words
  24.    i := 0
  25.    while word := wordlist[i +:= 1][1] do {
  26.       lines := ""                # build up line numbers
  27.       numbers := sort(wordlist[i][2])
  28.       while lines ||:= get(numbers) || ", "
  29.       write(left(word,maxword + 2),": ",lines[1:-2])
  30.       }
  31. end
  32.